perm filename FILL.FAI[XX,LCS]5 blob
sn#218819 filedate 1976-06-09 generic text, type T, neo UTF8
00100 TITLE FILL
00200 ENTRY FILLER,LINES,EDIT
00210 EXTERNAL .COMM.,ALF,RRJJ,SC,LPEN,MVBEAM,SCANR,UPDWN
00220 EXTERNAL DST,SIZ,PLTR,DPY,AIVECT,AVECT
00300 DEFINE FLOAT(N)
00400 < TLC N,232000
00500 FADR N,N >
00600 DEFINE FIXX(N)
00700 < JUMPGE N,.+5
00800 MOVNS N
00900 KAFIX N,233000
01000 MOVNS N
01100 CAIA
01200 KAFIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01300
01400 KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01500 RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01600 HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01700
01800 ; SUBROUTINE FILLER(Q,M)
01900 FILLER: 0
02000 MOVEM 16,SV16#
02100 HRRZ J,(16)
02200 HRRZM J,SVQ#
02300 HRRZ T,@1(16)
02400 HRRZM T,SVM# ; KK=NE(1)
02500 HRRZ KK,2(J)
02600 ADDI KK,-1(J)
02700 ; DO 4 K=2,KK
02800 HRRZI L,2(J)
02900 ; IF(NE(K).NE.3)GO TO 11
03000 L4: ADDI L,3
03100 HRRZ T,(L)
03200 L11: SETZM (L)
03300 CAIN T,3
03400 ; NE(K)=-1
03500 SETOM (L)
03600 ; GO TO 4
03700 ; 11 NE(K)=0
03800 ; 4 CONTINUE
03900 CAIGE L,(KK)
04000 JRST L4
04100 ; RLFT=10000
04200 MOVE RL,[=10000.0]
04300 ; RT=-10000
04400 MOVN RJ,[=10000.0]
04500 ; B=RT
04600 MOVE B,RJ
04700 ; DO 12 K=1,KK
04800 HRRZI L,-3(J)
04900 ; H=IFIX(Q(K))
05000 L12: ADDI L,3
05100 MOVE H,(L)
05200 FIXX(H)
05300 FLOAT(H)
05400 ; IF(H.LT.RLFT)RLFT=H
05500 CAMGE H,RL
05600 MOVE RL,H
05700
05800 ; IF(H.GT.RT)RT=H
05900 CAMLE H,RJ
06000 MOVE RJ,H
06100 ; IF(H.EQ.B)NE(K)=-1
06200 CAMN H,B
06300 SETOM 2(L)
06400 ; B=H
06500 MOVE B,H
06600 ; Q(K)=H
06700 MOVEM H,(L)
06800 ; 12 R(K)=IFIX(R(K))
06900 MOVE T,1(L)
07000 FIXX(T)
07100 FLOAT(T)
07200 MOVEM T,1(L)
07300 CAIGE L,-2(KK)
07400 JRST L12
07500 ; NE(KK+1)=-1
07600 SETOM 3(KK)
07700
07800 ; LRT=RT
07900 FIXX(RJ)
08000 MOVEM RJ,LRT#
08100 ; JA=3
08200 HRRZI T,3
08300 HRRZM T,JA#
08400
08500
08600 ; 124 LEFT=RLFT
08700 L124: MOVE LE,RL
08800 FIXX(LE)
08900 ; 51 J=LEFT
09000 L51: MOVE J,LE
09100 ; 42 RJ=J+.001
09200 L42: MOVE RJ,J
09300 FLOAT(RJ)
09400 FADR RJ,[=0.001]
09500 ; JCONT=0
09600 SETZM JCONT#
09700 ; LEFT=J
09800 MOVE LE,J
09900
10000 ; JJ=-1
10100 SETO JJ,
10200 ; ALT=-10000.
10300 MOVN AL,[=10000.0]
10400 ; 200 DO 45 L=2,KK
10500 HRRZ L,SVQ
10600 L45: ADDI L,3
10700 CAILE L,-2(KK)
10800 JRST L455
10900 ; IF(NE(L).NE.0)GO TO 45
11000 SKIPE 2(L)
11100 JRST L45
11200 ; IF(MISS(L,RJ,Q))GO TO 45
11300 CAML RJ,-3(L)
11400 JRST L201
11500 CAMLE RJ,(L)
11600 JRST L202
11700 L201: CAMGE RJ,(L)
11800 CAMG RJ,-3(L)
11900 JRST L45
12000 ; H=HGHT(L,RJ,Q,R)
12100 L202: MOVE H,-2(L)
12200 CAMN H,1(L)
12300 JRST RET
12400 MOVNS H
12500 FADR H,1(L)
12600 MOVE D,-3(L)
12700 MOVNS T,D
12800 FADR T,RJ
12900 FADR D,(L)
13000 FMPR H,T
13100 FDVR H,D
13200 FADR H,-2(L)
13300 ; IF(H.LT.ALT)GO TO 45
13400 RET: CAMGE H,AL
13500 JRST L45
13600
13700 ; ALT=H
13800 MOVE AL,H
13900 ; JJ=L
14000 HRRZI JJ,(L)
14100 ; 45 CONTINUE
14200 JRST L45
14300 ; IF(JJ)GO TO 43
14400 L455: JUMPL JJ,L43
14500 ; JCONT=-1
14600 SETOM JCONT
14700 ; LEFT=J
14800 MOVE LE,J
14900 ; 46 JA=3
15000 L46: HRRZI T,3
15100 HRRZM T,JA
15200 ; JORD=-1
15300 SETOM JORD#
15400 ; 52 KN=Q(JJ)
15500 L52: MOVE T,(JJ)
15600 FIXX(T)
15700 MOVEM T,KN#
15800 ; KL=Q(JJ-1)
15900 MOVE T,-3(JJ)
16000 FIXX(T)
16100
16200 MOVEM T,KL#
16300 ; IF(KN.LT.KL)KN=KL
16400 CAMLE T,KN
16500 MOVEM T,KN
16600 ; 50 I=J
16700 L50: MOVEM J,I#
16800 ; 102 RJ=I+.01
16900 L102: MOVE RJ,I
17000 FLOAT(RJ)
17110 FADR RJ,[=0.1] ;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
17200 ; ALT=HGHT(JJ,RJ,Q,R)
17300 MOVE AL,-2(JJ)
17400 CAMN AL,1(JJ)
17500 JRST RET2
17600 MOVNS AL
17700 FADR AL,1(JJ)
17800 MOVE D,-3(JJ)
17900 MOVNS T,D
18000 FADR T,RJ
18100 FADR D,(JJ)
18200 FMPR AL,T
18300 FDVR AL,D
18400 FADR AL,-2(JJ)
18500 ; B=-10000
18600 RET2: MOVN B,[=10000.0]
18700 ; JK=-1
18800 SETO JK,
18900 ; XALT=ALT+.001
19000 MOVE T,AL
19100 FADR T,[=0.001]
19200 MOVEM T,XALT#
19300
19400 ; ZALT=ALT
19500 MOVEM AL,ZALT#
19600 ; 400 DO 47 L=2,KK
19700 MOVE L,SVQ
19800 L47: ADDI L,3
19900 CAILE L,-2(KK)
20000 JRST L477
20100 ; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20200 CAME L,JJ
20300 SKIPGE 2(L)
20400 JRST L47
20500 CAML RJ,-3(L)
20600 JRST L475
20700 CAMLE RJ,(L)
20800 JRST L476
20900 L475: CAMGE RJ,(L)
21000 CAMG RJ,-3(L)
21100 JRST L47
21200 ; H=HGHT(L,RJ,Q,R)
21300 L476: MOVE H,-2(L)
21400 CAMN H,1(L)
21500 JRST RET3
21600 MOVNS H
21700 FADR H,1(L)
21800 MOVE D,-3(L)
21900 MOVNS T,D
22000 FADR T,RJ
22100 FADR D,(L)
22200 FMPR H,T
22300 FDVR H,D
22400 FADR H,-2(L)
22500 ; IF(H.GT.XALT)GO TO 47
22600 RET3: CAMG H,XALT
22700
22800 ; IF(H.LE.B)GO TO 47
22900 CAMG H,B
23000 JRST L47
23100 ; B=H
23200 MOVE B,H
23300 ; JK=L
23400 HRRZI JK,(L)
23500 ; 47 CONTINUE
23600 JRST L47
23700 ; IF(JK)GO TO 48
23800 L477: JUMPL JK,L48
23900 ; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24000 MOVN T,B
24100 FADR T,ZALT
24200 CAMG T,[=0.001]
24300 CAME J,I
24400 JRST L59
24500 ; JX=Q(JK)
24600 MOVE T,(JK)
24700 FIXX(T)
24800 ; IF(JX.GT.KN)GO TO 60
24900 CAMLE T,KN
25000 JRST L60
25100 ; JX=Q(JK-1)
25200 MOVE T,-3(JK)
25300 FIXX(T)
25400 ; IF(JX.LT.KN)GO TO 59
25500 CAMGE T,KN
25600 JRST L59
25700 ; 60 L=JJ
25800 L60: MOVE L,JJ
25900 ; JJ=JK
26000 MOVE JJ,JK
26100 ; JK=L
26200 MOVE JK,L
26300 ; KN=JX
26400 MOVEM T,KN
26500
26600 ; 59 IF(ALT-B.LT.2)GO TO 62
26700 L59: MOVN T,B
26800 FADR T,AL
26900 CAMGE T,[=2.0]
27000 JRST L62
27100 ; ALT=ALT-1
27200 HRLZI T,576400
27300 FADR AL,T
27400 ; B=B+1
27500 HRLZI T,201400
27600 FADR B,T
27700 ; 62 IF(JORD)GO TO 103
27800 L62: SKIPGE JORD
27900 JRST L103
28000 ; H=B
28100 MOVE H,B
28200 ; B=ALT
28300 MOVE B,AL
28400 ; ALT=H
28500 MOVE AL,H
28600 ; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28700
28800 CAMN JK,NK#
28900 JRST L103
29000 MOVN T,B
29100 FADR T,AL
29200 SKIPGE T
29300 MOVNS T
29400 CAMG T,[5.0]
29500 JRST L103
29600 HRRZI T,3
29700 HRRZM T,JA
29800 ; 103 CALL LINES(RJ,ALT,JA)
29900 L103: MOVEM RJ,SVRJ#
30000 MOVEM AL,SVAL#
30100 MOVEM B,SVB#
30200 HRRZI 16,SVAC
30300 BLT 16,SVAC+15
30400 JSA 16,LINES
30500 JUMP SVRJ
30600 JUMP SVAL
30700 JUMP JA
30800 ; 100 CALL LINES(RJ,B,2)
30900 JSA 16,LINES
31000 JUMP SVRJ
31100 JUMP SVB
31200 JUMP [2]
31300 HRLZI 16,SVAC
31400 BLT 16,15
31500 ; NK=JK
31600 MOVEM JK,NK
31700
31800 ; JORD=-JORD
31900 MOVNS JORD
32000 ; NE(JK)=1
32100 HRRZI T,1
32200 HRRZM T,2(JK)
32300 ; NE(JJ)=-1
32400 SETOM 2(JJ)
32500 ; JA=2
32600 HRRZI T,2
32700 HRRZM T,JA
32800 ; I=I+M
32900 MOVE T,SVM
33000 ADDB T,I
33100 ; IF(I.LT.KN)GO TO 102
33200 CAMGE T,KN
33300 JRST L102
33400 ; L=1
33500 HRRZI L,3
33600 ; IF(KN.EQ.KL)L=-1
33700 MOVE T,KN
33800 CAMN T,KL
33900 HRROI L,-3
34000 ; JJ=JJ+L
34100 ADD JJ,L
34200 ; J=0
34300 SETZ J,
34400 ; IF(L)J=-1
34500 SKIPGE L
34600 HRROI J,-3
34700 ; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34800 SKIPN 2(JJ)
34900 CAILE JJ,-2(KK)
35000 JRST L124
35100 ADD T,SVM
35200 FLOAT(T)
35300 HRRZI HG,(JJ)
35400 ADD HG,J
35500 CAMLE T,(HG)
35600 JRST L124
35700 ; J=I
35800 MOVE J,I
35900 ; GO TO 52
36000 JRST L52
36100 ; 48 JA=3
36200 L48: HRRZI T,3
36300 HRRZM T,JA
36500 ; 43 J=LEFT+M
36600 L43: MOVE J,LE
36700 ADD J,SVM
36800 ; IF(J.LE.LRT)GO TO 42
36900 CAMG J,LRT
37000 JRST L42
37100 ; IF(JCONT)GO TO 51
37200 SKIPGE JCONT
37300 JRST L51 ; END
37400 MOVE 16,SV16
37500 JRA 16,2(16)
37600 SVAC: BLOCK 16
37700
37800 ; SUBROUTINE LINES(A,B,L)
37900 ; COMMON/DST/BB,CC
38000 ; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38100 ; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38200 ; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38300 ; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38500 ; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38600 ; 1,(JJ2,JJ(2))
38700 ; DATA BB/.008/,CC/3.5/
38800 ;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38900
39000 M←2 ↔ N←3 ↔ K←4
39100
39200 LINES: 0
39300 ; GO TO 23
39400 JRST L23
39500 ;22 IF(JQ(1).NE.0)GO TO 23
39600 L22: SKIPE PLTR+=27
39700 JRST L23
39800 ; IF(CC.EQ.1000)GO TO 23
39900 MOVSI T,212764
40000 CAMN T,DST+1
40100 JRST L23
40200 ; B=B*(CC-BB*ABS(A))
40300 MOVE T,@(16)
40400 MOVM T,T
40500 FMPR T,DST
40600 FSBR T,DST+1
40700 FMPRM T,@1(16)
40800 MOVNS @1(16)
40900 ;23 IF(IPLT)GO TO 2
41000 ; M=A*RSZ
41100 L23: MOVE M,@(16)
41200 FMPR M,SIZ
41300 FIXX(M)
41400 ; N=B*RSZ
41500 MOVE N,@1(16)
41600 FMPR N,SIZ
41700 FIXX(N)
41800 ; IF(RSZ.LE.0.8571)GO TO 3
41900 MOVE T,[=0.8571]
42000 CAML T,SIZ
42100 ;; JRST L3
42200 JRST L6
42300
42400 SUB M,SIZ+1 ; M=M-JCEN
42500 SUB N,SIZ+2 ; N=N-KCEN
42600 ; IF(JA.NE.8)GO TO 5
42700 MOVEI T,10
42800 CAME T,.COMM.+1
42900 JRST L5
43000 ; IF(M.GT.511)M=511
43100 CAMLE M,[=511]
43200 HRRZI M,=511
43300 ; IF(M.LT.-511)M=-511
43400 CAMGE M,[-=511]
43500 HRROI M,-=511
43600 ;5 IF(IABS(M).GT.512)GO TO 77
43700 L5: CAIG M,=512
43800 CAMGE M,[-=512]
43900 JRST L77
44000 ; IF(IABS(N).LT.512)GO TO 4
44100 CAIGE N,=512
44200 CAMG N,[-=512]
44300 CAIA
44400 JRST LL4
44500 ;77 KZ=-1
44600 L77: SETOM KZ#
44700 ; RETURN
44800 JRA 16,3(16)
44900 ;4 IF(KZ.EQ.0)GO TO 6
45000 LL4: SKIPN KZ
45100 JRST L6
45200 ; KZ=0
45300 SETZM KZ
45400 MOVEM M,MM# ; GO TO 1
45500 MOVEM N,NN#
45600 JRST L1
45700 ;3 IF(JA.EQ.44)GO TO 6
45800 ;6 IF(JJ2.GT.3990)RETURN
45900 L6: MOVEI T,7626
46000 CAMGE T,DPY+1
46100 JRA 16,3(16)
46200 ; IF(L.EQ.3)GO TO 1
46300 MOVEM M,MM
46400 MOVEM N,NN
46500 HRRZI T,3
46600 CAMN T,@2(16)
46700 JRST L1
46800 ; CALL AVECT(M,N)
46900 JSA 16,AVECT
47000 JUMP MM
47100 JUMP NN
47200 ; RETURN
47300 JRA 16,3(16)
47400 ;1 CALL AIVECT(M,N)
47500 L1: JSA 16,AIVECT
47600 JUMP MM
47700 JUMP NN
47800 ; RETURN
47900 JRA 16,3(16)
48000 ;2 IF(IPLT.EQ.-2)RETURN
48100 ;;L2: MOVNI T,2
48200 ;; CAMN T,PLTR
48300 ;; JRA 16,3(16)
48400
48600 EDIT: 0 ; 00100 SUBROUTINE EDIT(JJA)
48700 ; 00200 COMMON/ALF/INP(72),ML /UPDWN/ RL,UD
48800 ; 00300 COMMON /SC/JL,LJ,MK
48900 ;00400 1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JM,JN,DBST,NFLG,IXX,ISEMI,QQ
49000 ; 00500 1 ,RVX(50),IAMP,A,RRN,B,MODE,IBLA
49100 ; 00600 COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
49200 ; 00700 COMMON/RRJJ/RJJ2,RJJ(20)
49300 ;00800 EQUIVALENCE (RVX1,RVX(1)),(RVX2,RVX(2)),(RVX4,RVX(4))
49400 ;00900 1,(RVX3,RVX(3)),(RJ6,RJJ(4)),(RJ9,RJJ(7)),(R3,RJQ(1))
49500 ;01000 1,(RJ5,RJJ(3)),(RJ10,RJJ(8)),(INP2,INP(2)),(INP20,INP(20))
49600 DEFINE JN<SC+=10> ↔ DEFINE ML <ALF+=72> ↔ DEFINE JA <.COMM.+1>
49700 DEFINE R2<.COMM.> ↔ DEFINE RJJ2<RRJJ> ↔ DEFINE UD <UPDWN+1>
49800 DEFINE RVX1<SC+=16> ↔ DEFINE RVX2<SC+=17> ↔ DEFINE RVX3<SC+=18>
49900 DEFINE RVX4<SC+=19> ↔ DEFINE RJ6<RRJJ+4> ↔ DEFINE RJ5<RRJJ+3>
50000 DEFINE RJ9<RRJJ+=7> ↔ DEFINE RJ10<RRJJ+=8> ↔ DEFINE R3<.COMM.+4>
50010 DEFINE RJ8<RRJJ+=6> ↔ DEFINE RJ7<RRJJ+=5>
50100 DEFINE INP2<ALF+1> ↔ DEFINE INP20<ALF+=19> ↔ DEFINE ISEMI<SC+=14>
50200 DEFINE RL<UPDWN> ↔ DEFINE RJJ <RRJJ+1>
50400 ; 01100 JN=-1
50500 SETOM JN
50600 MOVE @(16)
50700 MOVEM JJA#
50800 ; 01200 C THIS IS FLAG IN SCANR
50900 ; 01300 INP20=ISEMI
51000 MOVE 02,ISEMI
51100 MOVEM 02,INP20
51200 ; 01400 C SETS LIMIT IN SCANR
51300 ; 01500 ML=1
51400 MOVEI 02,1
51500 MOVEM 02,ML
51600 ; 01600 RVX2=0
51700 SETZM RVX2
51800 ; 01700 RVX4=0
51900 SETZM RVX4
52000 ;01800 C E=EDIT(55), C=COPY(2222), X=EXIT(222), DE=DEL(99), LP=LTPN
52100 ; 01900 CALL SCANR
52200 JSA 16,SCANR
52300 ; 02000 JN=0
52400 SETZM JN
52500 ; 02100 R2=RVX2
52600 MOVE 3,RVX2
52700 MOVEM 3,R2
52800 ; 02200 IF(RVX1.GT.10.)GO TO 7
52900 MOVSI 02,204500
53000 CAMGE 02,RVX1
53100 JRST E7
53200 ; 02300 JA=0
53300 SETZM JA
53400 SETZ 0, ; FOR E8
53500 ; 02400 IF(RVX2.NE.0)GO TO 8
53600 JUMPN 3,E8
53700 ; 02500 IF(INP2.EQ.'P')GO TO 5
53800 MOVE 02,[501004020100]
53900 CAMN 02,INP2
54000 JRST E5
54100 ; 02600 RVX2=RL
54200 MOVE 02,RL
54300 ; 02700 IF(RVX1.GT.2)RVX2=UD
54400 MOVSI 202400
54500 CAMGE RVX1
54600 MOVE 02,UD
54700 MOVEM 02,RVX2
54800 ; 02800 C STORES RT-LFT OR UP-DOWN INFO
54900 ; 02900 GO TO 8
55000 JRST E8
55100 ; 03200 C FOR LIGHT PEN MOVING
55200 E7: MOVE RVX1 ; 03300 7 JA=RVX1
55300 FIXX(0)
55500 MOVEM 00,JA
55600 CAIN =99 ;03400 IF(JA.EQ.99)R2=0
55700 SETZM R2
55800 ; 03500 IF(R2.NE.0)RETURN
55900 SKIPE R2
56000 JRA 16,1(16)
56100 CAIE =55 ;03600 IF(JA.NE.55)RETURN
56200 JRA 16,1(16)
56300 ; 03700 5 CALL LPEN(R3,R2,K)
56400 E5: JSA 16,LPEN
56500 JUMP R3
56600 JUMP R2
56700 JUMP 00,2 ; 2 IS A DUMMY HERE
56800 ; 03800 C ↑↑↑ K NOT USED!
56900 ;03900 CURSOR WILL FIND HORZ POS FOR 55 EDIT.(R3=STF,R2=HORZ) SEE 554 IN MAIN.
57000 ; 04000 IF(JA.EQ.0)CALL EXCH(R2,R3)
57100 MOVE 0,JA
57200 JUMPN 0,.+4
57300 MOVE 2,R2
57400 EXCH 2,R3
57500 MOVEM 2,R2
57600 ; 04100 RVX1=2.
57700 MOVSI 02,202400
57800 MOVEM 02,RVX1
57900 ; 04200 RVX2=R3-RJJ(1)
58000 MOVE 02,R3
58100 FSBR 02,RJJ
58200 MOVEM 02,RVX2
58300 ; 04300 RVX3=3.
58400 MOVSI 02,202600
58500 MOVEM 02,RVX3
58600 ; 04400 RJQ(2)=0
58700 SETZM .COMM.+5 ; R4
58800 ; 04500 RJJ2=R2
58900 MOVE 02,R2
59000 MOVEM 02,RJJ2
59100 ; 04700 C SO JD WILL BE 0 IN MAIN PROG.
59200 ; 04800 C FOR EDIT MODE
59300 E8: CAIN =55 ; 04900 8 IF(JA.EQ.55)RETURN
59400 JRA 16,1(16)
59500 ; 05000 IF(INP2.EQ.'P')GO TO 17
59600 MOVE 02,[501004020100]
59700 CAMN 02,INP2
59800 JRST E17
59900 ; 05100 IF(RVX1.GT.2)GO TO 117
60000 MOVSI 02,202400
60100 CAMGE 02,RVX1
60200 JRST E117
60300 ; 05200 RL=RVX2
60400 MOVE 02,RVX2
60500 MOVEM 02,RL
60600 SKIPE 2,RVX4 ; 05300 IF(RVX4.NE.0)UD=RVX4
60700 MOVEM 02,UD
60800 ; 05400 GO TO 17
60900 JRST E17
61000 ; 05500 117 IF(RVX4.NE.0)RL=RVX4
61100 E117: MOVE 02,RVX4
61200 JUMPE 02,.+3
61300 MOVE 02,RVX4
61400 MOVEM 02,RL
61500 ; 05600 UD=RVX2
61600 MOVE 02,RVX2
61700 MOVEM 02,UD
61800 ; 05700 17 R2=.00001
61900 E17: MOVE 02,[0.00001]
62000 MOVEM 02,R2
62100 ; 05800 JA=0
62200 SETZM JA
62300 MOVE 1,RVX1 ; 5900 K=RVX1
62400 FIXX(1)
62600 ;; MOVEM 00,K
62700 ; 06000 857 GO TO (1,2,3,4,2),K
62800 ;;E857: SKIPLE 1
62900 ;; CAILE 01,5
63000 ;; SKIPA 0
63050 MOVE 7,JJA ; KEEP CODE NUM IN AC0
63060 E857: JUMPLE 1,E1 ; IF(K.LE.0)K=1
63070 CAIL 1,5
63080 JRST E2 ; IF(K.GE.5)GO TO 2 -- CATCHES SOME ERRORS.
63100 E855: JRST @E855 (1)
63200 JUMP 00,E1
63300 JUMP 00,E2
63400 JUMP 00,E3
63500 JUMP 00,E4
63800 E4: MOVNS 00,RVX2 ; 06100 4 RVX2=-RVX2
63840 E3: CAIE 7,4
63860 JRST .+5 ; SKIP IF NOT CODE 4
63900 SKIPN RJ6 ;06300 SKIP OVER CLEFS (JJA=3) IS NOW REMOVED. 6/73
64000 SKIPE RJ5 ; 06400 3 CALL MVBEAM(RJJ,0,2,2,RVX2)
64025 SKIPA
64050 JRST E856 ; IGNORE BAR LINES -- IF(R5.EQ.0.AND.R6.EQ.0)GO TO 856
64100 JSA 16,MVBEAM
64200 JUMP RJJ
64300 JUMP [0] ;MVBEAM USES AC0→6
64400 JUMP [2]
64500 JUMP [2]
64600 JUMP RVX2
64700 ; 06500 C MOVES UP AND DOWN. HANDLES MINIS, ETC.
64800 ; ; 06600 IF(JJA.LT.4)GO TO 856
64900 CAIGE 7,4
65000 JRST E856
65100 CAILE 7,6 ; 06700 IF(JJA.GT.6)GO TO 856
65200 JRST E856
65300 ; 06800 C I THINK R2 MUST BE NON-ZERO TO WORK IN EDIT MODE?
65400 ; 06900 12 IF(RJ5.EQ.50)GO TO 856
65500 MOVSI 02,206620
65600 CAMN 02,RJ5
65700 JRST E856
65800 ; 07000 C 50=CRESC.-DECRESC.
65900 ; 07300 RJ5=RJ5+RVX2
66000 MOVE 02,RVX2
66100 FADRM 02,RJ5
66200 ; 07400 C MOVES 5TH PARAM UP OR DOWN
66300 JRST E856 ; 07500 GO TO 856
66400 ; 07600 1 RVX2=-RVX2
66500 E1: MOVNS 00,RVX2
66600 ; 07700 2 R2=RVX2
66700 E2: MOVE 02,RVX2
66800 MOVEM 02,R2
66900 ; 07800 856 IF(RVX4.EQ.0)GO TO 858
67000 E856: MOVE 3,RVX4
67100 JUMPE 3,E858
67200 MOVE 1,RVX3 ; 07900 K=RVX3
67300 FIXX(1) ; K IS IN 1
67600 ; 08000 RVX2=RVX4
67700 MOVEM 3,RVX2
67800 ; 08100 RVX4=0
67900 SETZM RVX4
68000 ; 08200 GO TO 857
68100 JRST E857
68200 ; 08300 858 IF(R2.EQ..00001)GO TO 7515
68300 E858: MOVE 2,R2
68400 CAMN 2,[0.00001]
68500 JRST E7515 ; 1 HAS R2
68600 ; 08400 IF(JJA.LT.5)GO TO 477
68700 CAIGE 7,5
68800 JRST E477
68900 CAIG 7,=8 ; 08500 IF(JJA.LE.8)GO TO 5515
69000 JRST E5515
69100 E477: CAIE 7,4 ; 08600 477 IF(JJA.NE.4)GO TO 7515
69200 JRST E7515
69300 SKIPN RJ6 ; 08700 IF(RJ6.EQ.0)GO TO 7515
69350 SKIPE RJ5 ; CHANGED↑↑↑ TO IF(RJ6.EQ.0.AND.RJ5.EQ.0)
69375 SKIPA ;RARE CASES MIGHT BE FOUND! USING P7≠0
69400 JRST E7515
69500 ; ; 08800 C ABOVE FOR P1=6 (BEAMS, SLURS, LINES)
69600 E5515: SKIPE RJ6 ;IF(RJ6.EQ.0)SKIP //GO BACK (UP-DOWN)5515 RJ6=RJ6+R2
69700 FADRM 2,RJ6
69800 CAIN 7,6 ; 09000 IF(JJA.NE.6)GO TO 7515
70100 SKIPN RJ9 ; 09100 IF(RJ9.EQ.0)GO TO 7515
70300 JRST E7515
70400 MOVE RJ10 ; 09200 IF(RJ10.NE.0)GO TO EDX1
70402 CAML [30.0]
70406 FADRM 2,RJ8 ; IF(RJ10.GE.30)RJ8=RJ8+R2
70410 JUMPN E7515-1
70420 SKIPN RJ8 ; IF(RJ8.NE.0)GO TO E7515-1
70440 SKIPGE RJ7 ; IF(RJ7.GE.0))GO TO E7515
70800 FADRM 2,RJ9 ; 09300 RJ9=RJ9+R2
71200 ;09400 RJ9(P9) IS LOC. OF INNER NOTE IN BEAM RANGE. SKIPS NUMBERS IN P9.
71300 ; 09500 7515 RJJ(1)=R2+RJJ(1)
71400 E7515: FADRM 2,RJJ
71500 JRA 16,1(16) ; 09600 END
71600 END